Import Billiken Sheets

Load libraries

library(tidyverse)
library(googlesheets4)
library(fuzzyjoin)

Import google sheets of Billiken League data

#Pull pre-draft data
prefreeze_rosters <- read_sheet("https://docs.google.com/spreadsheets/d/1ZjlBTRAnW8vTzdr4rY-ciQWmYMPvEF5xtGQkUNLg4a0/edit?gid=0#gid=0", sheet = "PreFreezeRosters", col_types = 'ccccccc') %>% 
  filter(!is.na(player))

✔ Reading from Blue Socks 2025 Pre-Draft.
✔ Range ''PreFreezeRosters''.

#If you created a new google sheet, don't forget to change sharing permissions to "anyone with the link can edit" or you will get OAuth errors
frozen_rosters <- read_sheet("https://docs.google.com/spreadsheets/d/1ZjlBTRAnW8vTzdr4rY-ciQWmYMPvEF5xtGQkUNLg4a0/edit?gid=1871666303#gid=1871666303", sheet = "FrozenRosters", col_types = 'cccccc')

✔ Reading from Blue Socks 2025 Pre-Draft.
✔ Range ''FrozenRosters''.

draft <- read_sheet("https://docs.google.com/spreadsheets/d/1ZjlBTRAnW8vTzdr4rY-ciQWmYMPvEF5xtGQkUNLg4a0/edit?gid=1008004729#gid=1008004729", sheet = "Draft", col_types = 'ciiicccccc')

✔ Reading from Blue Socks 2025 Pre-Draft.
✔ Range ''Draft''.
New names:

salaries <- read_sheet("https://docs.google.com/spreadsheets/d/1ZjlBTRAnW8vTzdr4rY-ciQWmYMPvEF5xtGQkUNLg4a0/edit?gid=1123952567#gid=1123952567", sheet = "Salaries", col_types = 'ccc') %>% 
    rename(new_salary = Salary)  %>% 
    filter(!is.na(Player)) %>%  
    mutate(across(c("new_salary"), ~gsub("\\$", "", .) %>% as.numeric))

✔ Reading from Blue Socks 2025 Pre-Draft.
✔ Range ''Salaries''.

positions <- suppressWarnings(read_sheet("https://docs.google.com/spreadsheets/d/1ZjlBTRAnW8vTzdr4rY-ciQWmYMPvEF5xtGQkUNLg4a0/edit?gid=605162437#gid=605162437", sheet = "Positions", col_types = 'ciiiiiiiiiii') %>% 
    mutate(PLAYER = gsub("\n.*","",PLAYER)) %>% 
    mutate(PLAYER = gsub("DTD.*","",PLAYER)) %>%
    mutate(p_of = case_when(RF == 1 ~ 1, CF == 1 ~ 1, LF == 1 ~ 1, .default = 0)) %>%
    mutate(p_ci = case_when(`1B` == 1 ~ 1, `3B` == 1 ~ 1, .default = 0)) %>%
    mutate(p_mi = case_when(`2B` == 1 ~ 1, SS == 1 ~ 1, .default = 0)) %>%  
    rename(player = PLAYER, p_c = C, p_1b = `1B`, p_2b = `2B`, p_3b = `3B`, p_ss = SS, p_dh = DH) %>% 
    select(player, p_c, p_1b, p_2b, p_3b, p_ss, p_of, p_ci, p_mi, p_dh))

✔ Reading from Blue Socks 2025 Pre-Draft.
✔ Range ''Positions''.

Load FanGraphs Depth Charts Projections files

hitter_projections <- read_csv("hitter_projections_2025.csv") %>% 
  mutate(Name = stringi::stri_trans_general(Name, "Latin-ASCII"))

Rows: 618 Columns: 74── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (4): Name, Team, NameASCII, PlayerId
dbl (45): G, PA, AB, H, 1B, 2B, 3B, HR, R, RBI, BB, IBB, SO, HBP, SF, SH, SB, CS, AVG, BB%, K%, BB/K, OBP, SLG, wOBA, OP...
lgl (25): GDP, InterSD, InterSK, IntraSD, Vol, Skew, Dim, P10, P20, P30, P40, P50, P60, P70, P80, P90, TT10, TT20, TT30,...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

pitcher_projections <- read_csv("pitcher_projections_2025.csv") %>% 
  mutate(Name = stringi::stri_trans_general(Name, "Latin-ASCII"))

Rows: 837 Columns: 69── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr  (4): Name, Team, NameASCII, PlayerId
dbl (37): W, L, QS, ERA, G, GS, SV, HLD, IP, TBF, H, R, ER, HR, BB, HBP, SO, K/9, BB/9, K/BB, HR/9, K%, BB%, K-BB%, AVG,...
lgl (28): BS, IBB, GB%, HR/FB, InterSD, InterSK, IntraSD, Vol, Skew, Dim, P10, P20, P30, P40, P50, P60, P70, P80, P90, T...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

hitter_projections

pitcher_projections

NA

Filter out non-player rows

prefreeze_rosters <- prefreeze_rosters %>% 
  filter(!is.na(player)) %>% 
  mutate(across(c("salary"), ~gsub("\\$", "", .) %>% as.numeric))

Warning: There was 1 warning in `mutate()`.
ℹ In argument: `across(c("salary"), ~gsub("\\$", "", .) %>% as.numeric)`.
Caused by warning in `gsub("\\$", "", salary) %>% as.numeric`:
! NAs introduced by coercion

prefreeze_rosters

  #filter(billikenTeam == "Blue Socks")

Merge projections with pre-freeze rosters

hitter_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  #left_join(prefreeze_rosters, join_by('Name'=='player')) 
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2)

pitcher_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  #left_join(prefreeze_rosters, join_by('Name'=='player')) 
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2)

NA

Team Totals

(hitter_team_totals <- hitter_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  group_by(billikenTeam) %>% 
  summarize(n=n(), PA = sum(PA), AB = sum(AB), H = sum(H), HR = sum(HR), R = sum(R), RBI = sum(RBI), SB = sum(SB), AVG = sum(H)/sum(AB)))

(pitcher_team_totals <- pitcher_projections %>% 
#Find NL projections only
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  group_by(billikenTeam) %>% 
  summarize(n=n(), W = sum(W), SV = sum(SV), IP = sum(IP), SO = sum(SO), ER = sum(ER), H = sum(H), BB = sum(BB), ERA = sum(ER)*9/sum(IP), WHIP = (sum(H)+sum(BB))/sum(IP)) )

NA
NA

Team Standings

#Rank Team Totals
n_teams <- pull(count(hitter_team_totals %>% filter(!is.na(billikenTeam)) %>% distinct(billikenTeam)))

hitter_points <- hitter_team_totals %>% 
  filter(!is.na(billikenTeam)) %>% 
  mutate(hr = n_teams+1 - dense_rank(desc(HR)), r = n_teams+1 - dense_rank(desc(R)), rbi = n_teams+1 - dense_rank(desc(RBI)), sb = n_teams+1 - dense_rank(desc(SB)), avg = n_teams+1 - dense_rank(desc(AVG))) %>% 
  mutate(hr_pct = (hr-1)/(n_teams-1), r_pct = (r-1)/(n_teams-1), rbi_pct = (rbi-1)/(n_teams-1), sb_pct = (sb-1)/(n_teams-1), avg_pct = (avg-1)/(n_teams-1)) %>% 
  mutate(hit = hr + r + rbi + sb + avg) %>% 
  arrange(desc(hit))

hitter_points

pitcher_points <- pitcher_team_totals %>% 
  filter(!is.na(billikenTeam)) %>% 
  mutate(w = n_teams+1 - dense_rank(desc(W)), sv = n_teams+1 - dense_rank(desc(SV)), so = n_teams+1 - dense_rank(desc(SO)), era = n_teams+1 - dense_rank(ERA), whip = n_teams+1 - dense_rank(WHIP)) %>%
  mutate(w_pct = (w-1)/(n_teams-1), sv_pct = (sv-1)/(n_teams-1), so_pct = (so-1)/(n_teams-1), era_pct = (era-1)/(n_teams-1), whip_pct = (whip-1)/(n_teams-1)) %>%
  mutate(pit = w + sv + so + era + whip) %>% 
  arrange(desc(pit))

pitcher_points

NA

Project category variability

ggplot(hitter_points, aes(HR, hr_pct)) +
  geom_point() +
  stat_smooth(method="glm", method.args = list(family=binomial))

ggplot(pitcher_points, aes(ERA, era_pct)) +
  geom_point() +
  stat_smooth(method="glm", method.args = list(family=binomial))

Fit logistic regression curves

w_model_glm <- glm(w_pct ~ W, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$w_pts_pred = predict(w_model_glm, pitcher_points, type="response")*8+1

sv_model_glm <- glm(sv_pct ~ SV, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$sv_pts_pred = predict(sv_model_glm, pitcher_points, type="response")*8+1

so_model_glm <- glm(so_pct ~ SO, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$so_pts_pred = predict(so_model_glm, pitcher_points, type="response")*8+1

era_model_glm <- glm(era_pct ~ ERA, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$era_pts_pred = predict(era_model_glm, pitcher_points, type="response")*8+1

whip_model_glm <- glm(whip_pct ~ WHIP, data = pitcher_points, family = "binomial")

Warning: non-integer #successes in a binomial glm!

pitcher_points$whip_pts_pred = predict(whip_model_glm, pitcher_points, type="response")*8+1

(pitcher_points <- pitcher_points %>% 
  mutate(pitcher_points_pred = w_pts_pred + sv_pts_pred + so_pts_pred + era_pts_pred + whip_pts_pred) %>% 
    arrange(desc(pitcher_points_pred)))

Player projected point impact (average, not situation-based)

Simple linear model by category

hr_model <- lm(hr ~ HR, hitter_points) 
r_model <- lm(r ~ R, hitter_points) 
rbi_model <- lm(rbi ~ RBI, hitter_points) 
sb_model <- lm(sb ~ SB, hitter_points) 
avg_model <- lm(avg ~ AVG, hitter_points) 

w_model <- lm(w ~ W, pitcher_points) 
sv_model <- lm(sv ~ SV, pitcher_points) 
so_model <- lm(so ~ SO, pitcher_points) 
era_model <- lm(era ~ ERA, pitcher_points) 
whip_model <- lm(whip ~ WHIP, pitcher_points) 

hr_factor = hr_model$coefficients["HR"]
r_factor = r_model$coefficients["R"]
rbi_factor = rbi_model$coefficients["RBI"]
sb_factor = sb_model$coefficients["SB"]
avg_factor = avg_model$coefficients["AVG"]

melonheads_h <- pull(hitter_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(H))
melonheads_ab <- pull(hitter_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(AB))

w_factor = w_model$coefficients["W"]
sv_factor = sv_model$coefficients["SV"]
so_factor = so_model$coefficients["SO"]
era_factor = era_model$coefficients["ERA"]
whip_factor = whip_model$coefficients["WHIP"]

melonheads_ip <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(IP))
melonheads_er <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(ER))
melonheads_wh <- pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(BB)) + pull(pitcher_team_totals %>% filter(billikenTeam == "Melonheads") %>% select(H))

Build list of project draft value

#List of available players
hitter_projections %>% 
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  filter(is.na(billikenTeam)) %>% 
  mutate(AVG = round(AVG,3)) %>% 
  mutate(point_value = round(HR * hr_factor + R * r_factor + RBI * rbi_factor + SB * sb_factor + avg_factor * ((melonheads_h + H)/(melonheads_ab + AB) - melonheads_h/melonheads_ab),1)) %>%  
  select(Name, Team, PA, HR, R, RBI, SB, AVG, point_value) %>% 
  arrange(desc(point_value))

NA

hitter_projections <- hitter_projections %>% 
  mutate(point_value = round(HR * hr_factor + R * r_factor + RBI * rbi_factor + SB * sb_factor + avg_factor * ((melonheads_h + H)/(melonheads_ab + AB) - melonheads_h/melonheads_ab),1))

pitcher_projections <- pitcher_projections %>% 
  mutate(point_value = round(W * w_factor + SV * sv_factor + SO * so_factor + era_factor * (9*(melonheads_er + ER)/(melonheads_ip + IP) - 9*melonheads_er/melonheads_ip) + whip_factor * ((melonheads_wh + BB + H)/(melonheads_ip + IP) - melonheads_wh/melonheads_ip),1))

bind_rows(hitter_projections, pitcher_projections) %>% 
  #filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  filter(billikenTeam == "Melonheads") %>% 
  mutate(AVG = round(AVG,3), ERA = round(ERA,2), WHIP = round(WHIP,2)) %>%  
  select(Name, Team, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, point_value) %>% 
  arrange(desc(point_value))

NA

All projected players with billiken league details

projected_players <- bind_rows(hitter_projections, pitcher_projections) %>% 
  filter(Team %in% c('ATL','LAD','SDP','ARI','NYM','PHI','MIL','STL','CHC','SFG','CIN','COL','PIT','MIA','WSN','NA')) %>%
  stringdist_left_join(prefreeze_rosters, by = c("Name" = "player"), max_dist = 2) %>% 
  stringdist_left_join(positions, by = c("Name" = "player"), max_dist = 2) %>% 
  #stringdist_left_join(salaries, by = c("Name" = "Player"), max_dist = 2) %>% 
  #mutate(salary = case_when(!is.na(billikenTeam) ~ salary, TRUE ~ new_salary)) %>% 
  #filter(is.na(Owner) & !is.na(billikenTeam)) %>% 
  mutate(AVG = round(AVG,3), ERA = round(ERA,2), WHIP = round(WHIP,2), SO = case_when(IP == 0 ~ NA, IP > 0 ~ SO)) %>%  
  mutate(HR = case_when(PA == 0 ~ NA, PA > 0 ~ HR), R = case_when(PA == 0 ~ NA, PA > 0 ~ R)) %>% 
  select(Name, billikenTeam, contract, salary, Team, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, point_value, p_c, p_1b, p_2b, p_3b, p_ss, p_of, p_ci, p_mi, p_dh) %>% 
  arrange(desc(point_value)) #%>% 
  #filter(billikenTeam == "Melonheads") 

projected_players

NA

Replacement level example plot

pos <- projected_players %>% 
  filter(p_c == 1) %>% 
  mutate(rank_c = row_number(desc(point_value)))

ggplot(pos, aes(x=rank_c, y=point_value)) +
  geom_point() +
  geom_vline(xintercept = 21, color = "red")

Calculate replacement level by position (with no shared positions)

rl_c <- projected_players %>% 
  filter(p_c == 1) %>% 
  filter(row_number(desc(point_value)) == 21L) %>% 
  mutate(pos = 'c') %>% 
  select(Name, pos, point_value)

rl_1b <- projected_players %>% 
  filter(p_1b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '1b') %>% 
  select(Name, pos, point_value)

rl_2b <- projected_players %>% 
  filter(p_2b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '2b') %>% 
  select(Name, pos, point_value)

rl_3b <- projected_players %>% 
  filter(p_3b == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = '3b') %>% 
  select(Name, pos, point_value)

rl_ss <- projected_players %>% 
  filter(p_ss == 1) %>% 
  filter(row_number(desc(point_value)) == 16L) %>% 
  mutate(pos = 'ss') %>% 
  select(Name, pos, point_value)

rl_of <- projected_players %>% 
  filter(p_of == 1) %>% 
  filter(row_number(desc(point_value)) == 51L) %>% 
  mutate(pos = 'of') %>% 
  select(Name, pos, point_value)

rl_ci <- projected_players %>% 
  filter(p_ci == 1) %>% 
  filter(row_number(desc(point_value)) == 31L) %>% 
  mutate(pos = 'ci') %>% 
  select(Name, pos, point_value)

rl_mi <- projected_players %>% 
  filter(p_mi == 1) %>% 
  filter(row_number(desc(point_value)) == 31L) %>% 
  mutate(pos = 'mi') %>% 
  select(Name, pos, point_value)

rl_dh <- projected_players %>% 
  filter(p_dh == 1) %>% 
  filter(row_number(desc(point_value)) == 11L) %>% 
  mutate(pos = 'dh') %>% 
  select(Name, pos, point_value)

rl_util <- projected_players %>% 
  filter(row_number(desc(point_value)) == 151L) %>% 
  mutate(pos = 'util') %>% 
  select(Name, pos, point_value)

rl_p <- projected_players %>% 
  filter(IP > 0) %>% 
  filter(row_number(desc(point_value)) == 91L) %>% 
  mutate(pos = 'p') %>% 
  select(Name, pos, point_value)

(replacement_level <- rbind(rl_c, rl_1b, rl_2b, rl_3b, rl_ss, rl_of, rl_ci, rl_mi, rl_dh, rl_util, rl_p))

NA

Note - multiposition players not totally clean here.

Assume that we use the lowest replacement level of any position a player qualifies for.

Points Above Replacement

par <- projected_players %>% 
  mutate(repl = case_when(IP > 0 ~ 1.7, 
                          p_c == 1 ~ 1.9,
                          .default = 4.1)
         ) %>% 
  mutate(par = point_value - repl) %>% 
  arrange(desc(par)) %>% 
  select(Name, Team, billikenTeam, contract, salary, point_value, repl, par, PA, HR, R, RBI, SB, AVG, IP, W, SV, SO, ERA, WHIP, p_c, p_1b, p_2b, p_3b, p_ss, p_of, p_ci, p_mi, p_dh)

par

ggplot(par, aes(par,salary)) +
  geom_point() +
  geom_smooth(method="lm")

ev_model <- lm(salary ~ par, par) 


#par$ev <- par$par*2.118+4.840
par$ev <- par$par*2.583+10.355

par$surplus <- par$ev - par$salary

Projections by Billiken Team

par %>% 
  #filter(is.na(Owner) & !is.na(billikenTeam)) %>% 
  #filter(IP>0) %>% 
  filter(billikenTeam == "Blue Socks") %>% 
  relocate(surplus, .after = par) %>% 
  arrange(desc(par)) 

  #arrange(surplus) 

Add in new salaries

Project/simulate draft - Project/simulate next draft pick

Factor in salaries and cap

Build form for draft picks with projected standings

par %>% 
  filter(is.na(billikenTeam)) %>% 
  relocate(surplus, .after = par) %>% 
  #filter(IP > 0 ) %>% 
  arrange(desc(par)) 

  #arrange(desc(surplus))